home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / AUDPASS.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-27  |  6.5 KB  |  261 lines
  1. 10  'AUDPASS - Passive Audio Filters - 05 MAY 95  rev. 27 SEP 96
  2. 20  CLS:KEY OFF
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  COLOR 7,0,1
  5. 50  DIM C(7)
  6. 60  DIM L(3)
  7. 70  PI=3.14159
  8. 80  UL$=STRING$(80,205)
  9. 90  U1$="#####.#"
  10. 100  U2$="####.###"
  11. 110  '
  12. 120  '.....start
  13. 130  FOR Z=1 TO 7:C(Z)=0:NEXT Z
  14. 140  FOR Z=1 TO 3:L(Z)=0:NEXT Z
  15. 150  COLOR 15,2
  16. 160  PRINT " PASSIVE AUDIO FILTERS";TAB(57);"by George Murphy VE3ERP ";
  17. 170  COLOR 1,0:PRINT STRING$(80,223);
  18. 180  COLOR 7,0
  19. 190  '
  20. 200  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  21. 210  MENU=1
  22. 220  RO=2:CO=3:GOSUB 880
  23. 230  COLOR 15,0
  24. 240  LOCATE 9,4:PRINT "CLSSOUND<1> ELLIPTIC - 1 dB/50 dB"
  25. 250  COLOR 7,0
  26. 260  RO=2:CO=38:GOSUB 1170
  27. 270  COLOR 15,0
  28. 280  LOCATE 9,41:PRINT "CLSSOUND<2> ELLIPTIC - 0.18 dB/50.1 dB"
  29. 290  COLOR 7,0
  30. 300  RO=9:CO=38:GOSUB 1460
  31. 310  COLOR 15,0
  32. 320  LOCATE 16,42:PRINT "CLSSOUND<3> ELLIPTIC - 0.18 dB/81 dB"
  33. 330  COLOR 7,0
  34. 340  MENU=0
  35. 350  RO=16:CO=3:GOSUB 1700
  36. 360  COLOR 15,0
  37. 370  LOCATE 23,4:PRINT "CLSSOUND<4> BUTTERWORTH HIGH-PASS"
  38. 380  COLOR 7,0
  39. 390  RO=16:CO=38:GOSUB 1920
  40. 400  COLOR 15,0
  41. 410  LOCATE 23,40:PRINT "CLSSOUND<5> BUTTERWORTH LOW-PASS";
  42. 420  COLOR 7,0
  43. 430  '
  44. 440  '.....credits
  45. 450  COLOR 15,2
  46. 460  LOCATE 11,4:PRINT " Program suggested by Roel   "
  47. 470  LOCATE 12,4:PRINT " Koekoek, PA0RBK, based on   "
  48. 480  LOCATE 13,4:PRINT " data developed by Willem    "
  49. 490  LOCATE 14,4:PRINT " Chaudron, PE1GCS            "
  50. 500  COLOR 7,0
  51. 510  LOCATE 25,12:COLOR 15,1
  52. 520  PRINT " Press number in < > to select filter, or press 0 to EXIT ";
  53. 530  COLOR 7,0
  54. 540  Z$=INKEY$:Z=VAL(Z$)
  55. 550  IF Z$="0"THEN CLS:RUN EX$
  56. 560  IF Z>=1 AND Z<=5 THEN 590
  57. 570  GOTO 540
  58. 580  '
  59. 590  '.....input parameters
  60. 600  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  61. 610  GOSUB 2320    'preface notes
  62. 620  PRINT UL$;
  63. 630  INPUT " ENTER: Load Resistance.......(ohms)";R
  64. 640  INPUT " ENTER: Cutoff Frequency........(Hz)";FC
  65. 650  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  66. 660  KC=10^6/(2*PI*FC*R)        'capacitance constant
  67. 670  KL=R*10^3/(2*PI*FC)        'inductance constant
  68. 680  IF Z=1 THEN 740
  69. 690  IF Z=2 THEN 1000
  70. 700  IF Z=3 THEN 1290
  71. 710  IF Z=4 THEN 1580
  72. 720  IF Z=5 THEN 1800
  73. 730  '
  74. 740  '.....5-pole, 1 dB/50 dB
  75. 750  C(1)=1.933*KC
  76. 760  C(2)=0.223*KC
  77. 770  C(3)=2.392*KC
  78. 780  C(4)=0.626*KC
  79. 790  C(5)=1.635*KC
  80. 800  L(1)=0.963*KL
  81. 810  L(2)=0.75*KL
  82. 820  PRINT " 5-POLE ELLIPTIC LOW-PASS FILTER (1 dB / 50 dB)"
  83. 830  PRINT UL$;
  84. 840  RO=4:CO=2:GOSUB 880
  85. 850  PRINT UL$;
  86. 860  GOTO 2020
  87. 870  '
  88. 880  COLOR 0,7
  89. 890  LOCATE RO+1,CO:PRINT "          L1        L2         "
  90. 900  LOCATE RO+2,CO:PRINT "      VARPTRSOUNDORORORORORSOUNDCOLOR VARPTRSOUNDORORORORORSOUNDCOLOR      "
  91. 910  LOCATE RO+3,CO:PRINT "  SOUNDSOUNDSOUNDBSAVE<0xB4!>   C2  BLOADBSAVE<0xB4!>   C4  BLOADBSAVESOUNDSOUNDSOUND  "
  92. 920  LOCATE RO+4,CO:PRINT "     CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALL     "
  93. 930  LOCATE RO+5,CO:PRINT " DEFSNGR THENINSTRTHEN C1    THENINSTRTHEN C3  C5THENINSTRTHEN RDEFDBL "
  94. 940  IF MENU=1 THEN RO=RO-1:GOTO 960
  95. 950  LOCATE RO+6,CO:PRINT "     CALL         CALL         CALL     "
  96. 960  LOCATE RO+7,CO:PRINT "  SOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUND  "
  97. 970  COLOR 7,0
  98. 980  RETURN
  99. 990  '
  100. 1000  '.....7-pole, 0.18 dB/50.1 dB
  101. 1010  C(1)=1.183*KC
  102. 1020  C(2)=0.1853*KC
  103. 1030  C(3)=1.535*KC
  104. 1040  C(4)=0.9576*KC
  105. 1050  C(5)=1.307*KC
  106. 1060  C(6)=0.6755*KC
  107. 1070  C(7)=0.8543*KC
  108. 1080  L(1)=1.203*KL
  109. 1090  L(2)=0.7482*KL
  110. 1100  L(3)=0.8217*KL
  111. 1110  PRINT " 7-POLE ELLIPTIC LOW-PASS FILTER (0.18 dB / 50.1 dB)"
  112. 1120  PRINT UL$;
  113. 1130  RO=4:CO=2:GOSUB 1170
  114. 1140  PRINT UL$;
  115. 1150  GOTO 2020
  116. 1160  '
  117. 1170  COLOR 0,7
  118. 1180  LOCATE RO+1,CO:PRINT "          L1        L2        L3         "
  119. 1190  LOCATE RO+2,CO:PRINT "      VARPTRSOUNDORORORORORSOUNDCOLOR VARPTRSOUNDORORORORORSOUNDCOLOR VARPTRSOUNDORORORORORSOUNDCOLOR      "
  120. 1200  LOCATE RO+3,CO:PRINT "  SOUNDSOUNDSOUNDBSAVE<0xB4!>   C2  BLOADBSAVE<0xB4!>   C4  BLOADBSAVE<0xB4!>   C6  BLOADBSAVESOUNDSOUNDSOUND  "
  121. 1210  LOCATE RO+4,CO:PRINT "     CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALL     "
  122. 1220  LOCATE RO+5,CO:PRINT " DEFSNGR THENINSTRTHEN C1    THENINSTRTHEN C3    THENINSTRTHEN C5  C7THENINSTRTHEN RDEFDBL "
  123. 1230  IF MENU=1 THEN RO=RO-1:GOTO 1250
  124. 1240  LOCATE RO+6,CO:PRINT "     CALL         CALL         CALL         CALL     "
  125. 1250  LOCATE RO+7,CO:PRINT "  SOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUND  "
  126. 1260  COLOR 7,0
  127. 1270  RETURN
  128. 1280  '
  129. 1290  '.....7-pole, 0.18 dB/81 dB
  130. 1300  C(1)=1.28*KC
  131. 1310  C(2)=0.065*KC
  132. 1320  C(3)=1.943*KC
  133. 1330  C(4)=0.3079*KC
  134. 1340  C(5)=1.837*KC
  135. 1350  C(6)=0.2183*KC
  136. 1360  C(7)=1.143*KC
  137. 1370  L(1)=1.321*KL
  138. 1380  L(2)=1.183*KL
  139. 1390  L(3)=1.157*KL
  140. 1400  PRINT " 7-POLE ELLIPTIC LOW-PASS FILTER (0.18 dB / 81 dB)"
  141. 1410  PRINT UL$;
  142. 1420  RO=4:CO=2:GOSUB 1460
  143. 1430  PRINT UL$;
  144. 1440  GOTO 2020
  145. 1450  '
  146. 1460  COLOR 0,7
  147. 1470  LOCATE RO+1,CO:PRINT "          L1        L2        L3         "
  148. 1480  LOCATE RO+2,CO:PRINT "      VARPTRSOUNDORORORORORSOUNDCOLOR VARPTRSOUNDORORORORORSOUNDCOLOR VARPTRSOUNDORORORORORSOUNDCOLOR      "
  149. 1490  LOCATE RO+3,CO:PRINT "   SOUNDSOUNDBSAVE<0xB4!>   C2  BLOADBSAVE<0xB4!>   C4  BLOADBSAVE<0xB4!>   C6  BLOADBSAVESOUNDSOUNDSOUND  "
  150. 1500  LOCATE RO+4,CO:PRINT "     CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALLCLSSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUND'CALL     "
  151. 1510  LOCATE RO+5,CO:PRINT " DEFSNGR THENINSTRTHEN C1    THENINSTRTHEN C3    THENINSTRTHEN C5  C7THENINSTRTHEN RDEFDBL "
  152. 1520  IF MENU=1 THEN RO=RO-1:GOTO 1540
  153. 1530  LOCATE RO+6,CO:PRINT "     CALL         CALL         CALL         CALL     "
  154. 1540  LOCATE RO+7,CO:PRINT "   SOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUND  "
  155. 1550  COLOR 7,0
  156. 1560  RETURN
  157. 1570  '
  158. 1580  '.....hi-pass Butterworth
  159. 1590  C(1)=1.618*KC
  160. 1600  C(2)=0.5*KC
  161. 1610  C(3)=1.618*KC
  162. 1620  L(1)=0.618*KL
  163. 1630  L(2)=0.618*KL
  164. 1640  PRINT " BUTTERWORTH HIGH-PASS FILTER"
  165. 1650  PRINT UL$;
  166. 1660  RO=4:CO=2:GOSUB 1700
  167. 1670  PRINT UL$;
  168. 1680  GOTO 2020
  169. 1690  '
  170. 1700  COLOR 0,7
  171. 1710  LOCATE RO+1,CO:PRINT "       C1      C2      C3      "
  172. 1720  LOCATE RO+2,CO:PRINT "  SOUNDSOUNDSOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDUSINGSOUNDSOUNDSOUNDSOUNDSOUND  "
  173. 1730  LOCATE RO+3,CO:PRINT "           CALL       CALL           "
  174. 1740  LOCATE RO+4,CO:PRINT " DEFSNGR       OROROR     OROROR       RDEFDBL "
  175. 1750  LOCATE RO+5,CO:PRINT "           CALLL1     CALLL2         "
  176. 1760  LOCATE RO+6,CO:PRINT "  SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND  "
  177. 1770  COLOR 7,0
  178. 1780  RETURN
  179. 1790  '
  180. 1800  '.....lo-pass Butterworth
  181. 1810  C(1)=1.618*KC
  182. 1820  C(2)=1.618*KC
  183. 1830  L(1)=0.618*KL
  184. 1840  L(2)=2*KL
  185. 1850  L(3)=0.618*KL
  186. 1860  PRINT " BUTTERWORTH LOW-PASS FILTER"
  187. 1870  PRINT UL$;
  188. 1880  RO=4:CO=2:GOSUB 1920
  189. 1890  PRINT UL$;
  190. 1900  GOTO 2020
  191. 1910  '
  192. 1920  COLOR 0,7
  193. 1930  LOCATE RO+1,CO:PRINT "       L1      L2      L3      "
  194. 1940  LOCATE RO+2,CO:PRINT "  SOUNDSOUNDSOUNDORORORORORSOUNDBSAVESOUNDORORORORORSOUNDBSAVESOUNDORORORORORORSOUNDSOUND  "
  195. 1950  LOCATE RO+3,CO:PRINT "           CALL       CALL           "
  196. 1960  LOCATE RO+4,CO:PRINT " DEFSNGR       THENINSTRTHEN C1  THENINSTRTHEN C2    RDEFDBL "
  197. 1970  LOCATE RO+5,CO:PRINT "           CALL       CALL           "
  198. 1980  LOCATE RO+6,CO:PRINT "  SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND  "
  199. 1990  COLOR 7,0
  200. 2000  RETURN
  201. 2010  '
  202. 2020  '.....screen display
  203. 2030  LN=CSRLIN-1
  204. 2040  FOR Z=1 TO 3
  205. 2050  IF L(Z)=0 THEN 2080
  206. 2060  L$="L"+RIGHT$(STR$(Z),1)
  207. 2070  PRINT TAB(24);L$;" =";USING U2$;L(Z);:PRINT " mH"
  208. 2080  NEXT Z
  209. 2090  '
  210. 2100  FOR Z=1 TO 7
  211. 2110  IF C(Z)=0 THEN 2150
  212. 2120  C$="C"+RIGHT$(STR$(Z),1)
  213. 2130  LN=LN+1:LOCATE LN
  214. 2140  PRINT " ";C$;" =";USING U2$;C(Z);:PRINT " >F"
  215. 2150  NEXT Z
  216. 2160  '
  217. 2170  LOCATE RO+1,45:
  218. 2180  PRINT "1-ohm, 1 radian/second"
  219. 2190  LOCATE RO+3,45:
  220. 2200  PRINT "Cutoff Frequency:   ";USING U1$;FC;:PRINT " Hz."
  221. 2210  LOCATE RO+5,45
  222. 2220  PRINT "Load Resistance DEFSNGRDEFDBL:";USING U1$;R;:PRINT " -"
  223. 2230  LOCATE 20,2:PRINT "Use nearest standard 5% tolerance capacitors and ";
  224. 2240  PRINT "inductors."
  225. 2250  PRINT " Toroid inductors may be designed using HAMCALC's Toroid Inductor ";
  226. 2260  PRINT "Calculator."
  227. 2270  PRINT UL$;
  228. 2280  GOSUB 2480    'screen dump
  229. 2290  CLS:GOTO 120  'start
  230. 2300  END
  231. 2310  '
  232. 2320  '.....preface
  233. 2330  T=10
  234. 2340  PRINT TAB(T);
  235. 2350  PRINT "The formulae used in this program were developed by Willem"
  236. 2360  PRINT TAB(T);
  237. 2370  PRINT "Chaudron, PE1GCS, primarily for use as audio filters. Roel"
  238. 2380  PRINT TAB(T);
  239. 2390  PRINT "Koekoek, PA0RBK, advises that he has also used this program"
  240. 2400  PRINT TAB(T);
  241. 2410  PRINT "to design RF filters that are reasonably accurate up to about"
  242. 2420  PRINT TAB(T);
  243. 2430  PRINT "30 MHz by entering the frequency in KHz and reading the results"
  244. 2440  PRINT TAB(T);
  245. 2450  PRINT "as being in nF and >H."
  246. 2460  RETURN
  247. 2470  '
  248. 2480  'HARDCOPY
  249. 2490  GOSUB 2600:LOCATE 25,2:COLOR 14,6
  250. 2500  PRINT " Press 1 to print screen, 2 to print screen & ";
  251. 2510  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  252. 2520  Z$=INKEY$:IF Z$="3"THEN GOSUB 2600:RETURN
  253. 2530  IF Z$="1"OR Z$="2"THEN GOSUB 2600:GOTO 2550
  254. 2540  GOTO 2520
  255. 2550  FOR QX=1 TO 24:FOR QY=1 TO 80
  256. 2560  LPRINT CHR$(SCREEN(QX,QY));
  257. 2570  NEXT QY:NEXT QX
  258. 2580  IF Z$="2"THEN LPRINT CHR$(12)
  259. 2590  GOTO 2490
  260. 2600  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  261.